home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / $_1_ / Date / Parse.pm < prev   
Encoding:
Perl POD Document  |  2003-06-09  |  9.0 KB  |  380 lines
  1. # Date::Parse $Id: //depot/TimeDate/lib/Date/Parse.pm#22 $
  2. #
  3. # Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
  4. # software; you can redistribute it and/or modify it under the same terms
  5. # as Perl itself.
  6.  
  7. package Date::Parse;
  8.  
  9. require 5.000;
  10. use strict;
  11. use vars qw($VERSION @ISA @EXPORT);
  12. use Time::Local;
  13. use Carp;
  14. use Time::Zone;
  15. use Exporter;
  16.  
  17. @ISA = qw(Exporter);
  18. @EXPORT = qw(&strtotime &str2time &strptime);
  19.  
  20. $VERSION = "2.27";
  21.  
  22. my %month = (
  23.     january        => 0,
  24.     february    => 1,
  25.     march        => 2,
  26.     april        => 3,
  27.     may        => 4,
  28.     june        => 5,
  29.     july        => 6,
  30.     august        => 7,
  31.     september    => 8,
  32.     sept        => 8,
  33.     october        => 9,
  34.     november    => 10,
  35.     december    => 11,
  36.     );
  37.  
  38. my %day = (
  39.     sunday        => 0,
  40.     monday        => 1,
  41.     tuesday        => 2,
  42.     tues        => 2,
  43.     wednesday    => 3,
  44.     wednes        => 3,
  45.     thursday    => 4,
  46.     thur        => 4,
  47.     thurs        => 4,
  48.     friday        => 5,
  49.     saturday    => 6,
  50.     );
  51.  
  52. my @suf = (qw(th st nd rd th th th th th th)) x 3;
  53. @suf[11,12,13] = qw(th th th);
  54.  
  55. #Abbreviations
  56.  
  57. map { $month{substr($_,0,3)} = $month{$_} } keys %month;
  58. map { $day{substr($_,0,3)}   = $day{$_} }   keys %day;
  59.  
  60. my $strptime = <<'ESQ';
  61.  my %month = map { lc $_ } %$mon_ref;
  62.  my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref);
  63.  my $monpat = join("|", reverse sort keys %month);
  64.  my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref);
  65.  
  66.  my %ampm = (
  67.     'a' => 0,  # AM
  68.     'p' => 12, # PM
  69.     );
  70.  
  71.  my($AM, $PM) = (0,12);
  72.  
  73. sub {
  74.  
  75.   my $dtstr = lc shift;
  76.   my $merid = 24;
  77.  
  78.   my($year,$month,$day,$hh,$mm,$ss,$zone,$dst,$frac);
  79.  
  80.   $zone = tz_offset(shift) if @_;
  81.  
  82.   1 while $dtstr =~ s#\([^\(\)]*\)# #o;
  83.  
  84.   $dtstr =~ s#(\A|\n|\Z)# #sog;
  85.  
  86.   # ignore day names
  87.   $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog;
  88.   $dtstr =~ s/,/ /g;
  89.   $dtstr =~ s#($daypat)\s*(den\s)?# #o;
  90.   # Time: 12:00 or 12:00:00 with optional am/pm
  91.  
  92.   return unless $dtstr =~ /\S/;
  93.   
  94.   if ($dtstr =~ s/\s(\d{4})([-:]?)(\d\d?)\2(\d\d?)(?:[Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
  95.     ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$3-1,$4,$5,$7,$8,$9);
  96.   }
  97.  
  98.   unless (defined $hh) {
  99.     if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?\s*(?:([ap])\.?m?\.?)?\s# #o) {
  100.       ($hh,$mm,$ss) = ($1,$2,$4 || 0);
  101.       $merid = $ampm{$5} if $5;
  102.     }
  103.  
  104.     # Time: 12 am
  105.     
  106.     elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) {
  107.       ($hh,$mm,$ss) = ($1,0,0);
  108.       $merid = $ampm{$2};
  109.     }
  110.   }
  111.     
  112.   if (defined $hh and $hh <= 12 and $dtstr =~ s# ([ap])\.?m?\.?\s# #o) {
  113.     $merid = $ampm{$1};
  114.   }
  115.  
  116.  
  117.   unless (defined $year) {
  118.     # Date: 12-June-96 (using - . or /)
  119.     
  120.     if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) {
  121.       ($month,$day) = ($month{$3},$1);
  122.       $year = $5 if $5;
  123.     }
  124.     
  125.     # Date: 12-12-96 (using '-', '.' or '/' )
  126.     
  127.     elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) {
  128.       ($month,$day) = ($1 - 1,$3);
  129.  
  130.       if ($5) {
  131.     $year = $5;
  132.     # Possible match for 1995-01-24 (short mainframe date format);
  133.     ($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12;
  134.     return if length($year) > 2 and $year < 1901;
  135.       }
  136.     }
  137.     elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) {
  138.       ($month,$day) = ($month{$3},$1);
  139.     }
  140.     elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) {
  141.       ($month,$day) = ($month{$1},$2);
  142.     }
  143.  
  144.     # Date: 961212
  145.  
  146.     elsif ($dtstr =~ s#\s(\d\d)(\d\d)(\d\d)\s# #o) {
  147.       ($year,$month,$day) = ($1,$2-1,$3);
  148.     }
  149.  
  150.     $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o;
  151.  
  152.   }
  153.  
  154.   # Zone
  155.  
  156.   $dst = 1 if $dtstr =~ s#\bdst\b##o;
  157.  
  158.   if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) {
  159.     $dst = 1 if $2 and $2 eq 'dst';
  160.     $zone = tz_offset($1);
  161.     return unless defined $zone;
  162.   }
  163.   elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?):?(\d\d)?(00)?\s# #o) {
  164.     my $m = defined($4) ? "$2$4" : 0;
  165.     my $h = "$2$3";
  166.     $zone = defined($1) ? tz_offset($1) : 0;
  167.     return unless defined $zone;
  168.     $zone += 60 * ($m + (60 * $h));
  169.   }
  170.  
  171.   if ($dtstr =~ /\S/) {
  172.     # now for some dumb dates
  173.     if ($dtstr =~ s/^\s*(ut?|z)\s*$//) {
  174.       $zone = 0;
  175.     }
  176.     elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) {
  177.       my $m = defined($4) ? "$2$4" : 0;
  178.       my $h = "$2$3";
  179.       $zone = defined($1) ? tz_offset($1) : 0;
  180.       return unless defined $zone;
  181.       $zone += 60 * ($m + (60 * $h));
  182.     }
  183.  
  184.     return if $dtstr =~ /\S/o;
  185.   }
  186.  
  187.   if (defined $hh) {
  188.     if ($hh == 12) {
  189.       $hh = 0 if $merid == $AM;
  190.     }
  191.     elsif ($merid == $PM) {
  192.       $hh += 12;
  193.     }
  194.   }
  195.  
  196.   $year -= 1900 if defined $year && $year > 1900;
  197.  
  198.   $zone += 3600 if defined $zone && $dst;
  199.   $ss += "0.$frac" if $frac;
  200.  
  201.   return ($ss,$mm,$hh,$day,$month,$year,$zone);
  202. }
  203. ESQ
  204.  
  205. use vars qw($day_ref $mon_ref $suf_ref $obj);
  206.  
  207. sub gen_parser
  208. {
  209.  local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
  210.  
  211.  if($obj)
  212.   {
  213.    my $obj_strptime = $strptime;
  214.    substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
  215.  shift; # package
  216. ESQ
  217.    my $sub = eval "$obj_strptime" or die $@;
  218.    return $sub;
  219.   }
  220.  
  221.  eval "$strptime" or die $@;
  222.  
  223. }
  224.  
  225. *strptime = gen_parser(\%day,\%month,\@suf);
  226.  
  227. sub str2time
  228. {
  229.  my @t = strptime(@_);
  230.  
  231.  return undef
  232.     unless @t;
  233.  
  234.  my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
  235.  my @lt  = localtime(time);
  236.  
  237.  $hh    ||= 0;
  238.  $mm    ||= 0;
  239.  $ss    ||= 0;
  240.  
  241.  my $frac = $ss - int($ss);
  242.  $ss = int $ss;
  243.  
  244.  $month = $lt[4]
  245.     unless(defined $month);
  246.  
  247.  $day  = $lt[3]
  248.     unless(defined $day);
  249.  
  250.  $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
  251.     unless(defined $year);
  252.  
  253.  return undef
  254.     unless($month <= 11 && $day >= 1 && $day <= 31
  255.         && $hh <= 23 && $mm <= 59 && $ss <= 59);
  256.  
  257.  my $result;
  258.  
  259.  if (defined $zone) {
  260.    $result = eval {
  261.      local $SIG{__DIE__} = sub {}; # Ick!
  262.      timegm($ss,$mm,$hh,$day,$month,$year);
  263.    };
  264.    return undef
  265.      if !defined $result
  266.         or $result == -1
  267.            && join("",$ss,$mm,$hh,$day,$month,$year)
  268.                  ne "595923311169";
  269.    $result -= $zone;
  270.  }
  271.  else {
  272.    $result = eval {
  273.      local $SIG{__DIE__} = sub {}; # Ick!
  274.      timelocal($ss,$mm,$hh,$day,$month,$year);
  275.    };
  276.    return undef
  277.      if !defined $result
  278.         or $result == -1
  279.            && join("",$ss,$mm,$hh,$day,$month,$year)
  280.                  ne join("",(localtime(-1))[0..5]);
  281.  }
  282.  
  283.  return $result + $frac;
  284. }
  285.  
  286. 1;
  287.  
  288. __END__
  289.  
  290.  
  291. =head1 NAME
  292.  
  293. Date::Parse - Parse date strings into time values
  294.  
  295. =head1 SYNOPSIS
  296.  
  297.     use Date::Parse;
  298.  
  299.     $time = str2time($date);
  300.  
  301.     ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($date);
  302.  
  303. =head1 DESCRIPTION
  304.  
  305. C<Date::Parse> provides two routines for parsing date strings into time values.
  306.  
  307. =over 4
  308.  
  309. =item str2time(DATE [, ZONE])
  310.  
  311. C<str2time> parses C<DATE> and returns a unix time value, or undef upon failure.
  312. C<ZONE>, if given, specifies the timezone to assume when parsing if the
  313. date string does not specify a timezome.
  314.  
  315. =item strptime(DATE [, ZONE])
  316.  
  317. C<strptime> takes the same arguments as str2time but returns an array of
  318. values C<($ss,$mm,$hh,$day,$month,$year,$zone)>. Elements are only defined
  319. if they could be extracted from the date string. The C<$zone> element is
  320. the timezone offset in seconds from GMT. An empty array is returned upon
  321. failure.
  322.  
  323. =head1 MULTI-LANGUAGE SUPPORT
  324.  
  325. Date::Parse is capable of parsing dates in several languages, these are
  326. English, French, German and Italian.
  327.  
  328.     $lang = Date::Language->new('German');
  329.     $lang->str2time("25 Jun 1996 21:09:55 +0100");
  330.  
  331. =head1 EXAMPLE DATES
  332.  
  333. Below is a sample list of dates that are known to be parsable with Date::Parse
  334.  
  335.  1995:01:24T09:08:17.1823213           ISO-8601
  336.  1995-01-24T09:08:17.1823213
  337.  Wed, 16 Jun 94 07:29:35 CST           Comma and day name are optional
  338.  Thu, 13 Oct 94 10:13:13 -0700
  339.  Wed, 9 Nov 1994 09:50:32 -0500 (EST)  Text in ()'s will be ignored.
  340.  21 dec 17:05                          Will be parsed in the current time zone
  341.  21-dec 17:05
  342.  21/dec 17:05
  343.  21/dec/93 17:05
  344.  1999 10:02:18 "GMT"
  345.  16 Nov 94 22:28:20 PST
  346.  
  347. =head1 LIMITATION
  348.  
  349. Date::Parse uses Time::Local internally, so is limited to only parsing dates
  350. which result in valid values for Time::Local::timelocal
  351.  
  352. =head1 BUGS
  353.  
  354. When both the month and the date are specified in the date as numbers
  355. they are always parsed assuming that the month number comes before the
  356. date. This is the usual format used in American dates.
  357.  
  358. The reason why it is like this and not dynamic is that it must be
  359. deterministic. Several people have suggested using the current locale,
  360. but this will not work as the date being parsed may not be in the format
  361. of the current locale.
  362.  
  363. My plans to address this, which will be in a future release, is to allow
  364. the programmer to state what order they want these values parsed in.
  365.  
  366. =head1 AUTHOR
  367.  
  368. Graham Barr <gbarr@pobox.com>
  369.  
  370. =head1 COPYRIGHT
  371.  
  372. Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
  373. software; you can redistribute it and/or modify it under the same terms
  374. as Perl itself.
  375.  
  376. =cut
  377.  
  378. # $Id: //depot/TimeDate/lib/Date/Parse.pm#22 $
  379.  
  380.